home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / a_utils / ffccflow / ffccflow.lha / ffccc+flow / ffccc / PUTOPT.f < prev    next >
Encoding:
Text File  |  1992-07-31  |  2.3 KB  |  69 lines

  1.       SUBROUTINE PUTOPT(SOPT,LOPT,ICHR,IERR)
  2. C! Put an operator on the stack 
  3.       include 'STACK.h' 
  4.       CHARACTER*(*) SOPT
  5.       include 'OPPREC.h' 
  6. C   
  7. C Here we use the operator precedence for Fortran to determine  
  8. C whether the addition of this operator will cause the stack
  9. C to be reduced. Note both right and left precedence is needed. 
  10. C Thanks to Julian Blake for this info. 
  11. C   
  12.       IERR = 0  
  13.       DO 10 I=1,LOPS
  14.          IF(ILENO(I).NE.LOPT)                                 GOTO 10   
  15.          IF(SOPT(:LOPT).EQ.COPER(I)(:LOPT))                      GOTO 20
  16.    10 CONTINUE  
  17.       IERR = 1  
  18. C not found ... not an operator 
  19.                                                                  GOTO 30
  20.    20 CONTINUE  
  21. C found. Operator number I  
  22.       IOP = I   
  23.       IPREC = IRITP(IOP)
  24. C   
  25. C     WRITE(6,100) NLEVL,(CTYP(I),COPD(I)(:LOPD(I)),COPT(I),
  26. C    &             IPOP(I),IPOS(I), 
  27. C    &             I=NLEVL,1,-1)
  28. C   
  29. C     WRITE(6,110) SOPT(:LOPT),IPREC
  30. C   
  31. C check if operator already present 
  32.       IF(COPT(NLEVL)(:1).NE.' ') THEN   
  33.          NLEVL = NLEVL + 1  
  34.          CTYP(NLEVL) = '$'  
  35.          COPD(NLEVL)(:LCOPD) = ' '  
  36.          LOPD(NLEVL) = 0
  37.          COPT(NLEVL)(:LOPER) = ' '  
  38.          COPT(NLEVL)(:LOPT) = SOPT(:LOPT)   
  39.          IPOP(NLEVL) = ILEFP(IOP)   
  40.          IPOS(NLEVL) = ICHR 
  41.          IERR = 0   
  42.                                                                  GOTO 30
  43.       ENDIF 
  44. C place operator on stack   
  45.       COPT(NLEVL)(:LOPER) = ' ' 
  46.       COPT(NLEVL)(:LOPT) = SOPT(:LOPT)  
  47.       IPOP(NLEVL) = ILEFP(IOP)  
  48.       IPOS(NLEVL) = ICHR
  49. C check for reduction of stack  
  50.       IF(NLEVL.EQ.1) THEN   
  51.          IERR = 0   
  52.                                                                  GOTO 30
  53.       ENDIF 
  54.       IF(IRITP(IOP).GT.IPOP(NLEVL-1)) THEN  
  55.          IERR = 0   
  56.                                                                  GOTO 30
  57.       ENDIF 
  58. C expression must be reduced
  59.       CALL REDEXP(IOP,IERR) 
  60.       IERR = -IERR  
  61.    30 CONTINUE  
  62.       RETURN
  63.   500 FORMAT(///,1X,'IN PUTOPT ... STACK LEVEL = ',I2, /,1X,
  64.      +'TYPE,OPERAND',23X,',OPERATOR,PRECEDENCE,POSITION', /,1X, 
  65.      +'---- -------',23('-'),' -------- ---------- --------', (/,1X,2X, 
  66.      +A1,2X,A30,8X,A2,6X,I2,8X,I2)) 
  67.   510 FORMAT(1X,'CURRENT OPERATOR -> ',A,' PRECEDENCE = ',I2)   
  68.       END   
  69.